*PGID 0010
0040 !
*DCLS 0050
0060 LIKE "*nomads"
0070 LOCAL PANEL_NM$,LIBRARY$
0080 LOCAL _FIL_NO,_KEYS$,_CURKEY,_CUR_KEY$,_KEY1,_KEY$,_SV_MSGLIB$,_FM_MSGLIB$,_NUMKEYS,QRY_VAL$,_CONTROL_NAME$,_FILE_NAME$,MIN_KEY$,MAX_KEY$,_NUMDEF$
0090 LOCAL _FYI$,_ERROR$,_MSG_DIRECTORY$,_MSG_END_OF_FIL$,_MSG_FILOPNERR1$,_MSG_JUST_CHECK$,_MSG_MANDATORY$,_MSG_NEXT$
0100 LOCAL _MSG_NON_NUMER$,_MSG_NOT_FOUND$,_MSG_OVRWRT_CHG$,_MSG_PRECEDING$,_MSG_PREFIX$,_MSG_REC_ACCESS$,_MSG_REC_ALTERD$
0110 LOCAL _MSG_REC_CR_NEW$,_MSG_REC_LOCKED$,_MSG_REC_MISS1$,_MSG_REC_MISS2$,_MSG_REC_NOTFND$,_MSG_REC_NO_1ST$,_MSG_REC_NO_LST$
0120 LOCAL _MSG_REC_REMOVE$,_MSG_REC_UPDADD$,_MSG_REC_VFYDEL1$,_MSG_REC_VFYDEL2$,_MSG_REC_VIEW1$,_MSG_REC_VIEW2$,_MSG_REQ_FIELDS$
0130 LOCAL _MSG_START_FILE$,_MSG_UPDATE$,_MSG_UPD_OTHER1$,_MSG_UPD_OTHER2$,_MSG_UPD_SAME$,_MSG_WARNING$,_MSG_CANNOT_WRITE$,_MSG_DUP_UNIQUE$
0140 LOCAL _ENABLE_FLG,_KCNT,_FIRST_KEY,_FIRST_FIELD,_CUR$,_ORIG$,_ORIG_LIST$,_CUR_LIST$,_ORIGLIST$,_STRVAR_LIST$,_INTERFACE$,_IF_ERR$,_IF_ABSENT$,isArg
*DEL  0150-0150
*SKIP 0150 IF FLDR=0
0150 LOCAL FIRST_TAB$,LAST_TAB$,TAB_FLG$,_ONFOCUSFOLDER_TAB_1$,_ONFOCUSFOLDER_TAB_2$,_ONFOCUSFOLDER_TAB_2M$,_FOLDER_DISPLAY_LOGIC$
0160 PROPERTY SCREEN_ID$=PANEL_NM$
0170 PROPERTY SCREEN_LIB$=LIBRARY$
0180 FUNCTION SETUPMESSAGES()SETUP_MESSAGES
0190 FUNCTION PRELOAD()INIT
0200 FUNCTION POSTLOAD()MAIN_POST_DISPLAY
0210 FUNCTION ONEXIT()WRAPUP
0220 FUNCTION BUTTON_FIRST()FIRST_REC
0230 FUNCTION BUTTON_LAST()LAST_REC
0240 FUNCTION BUTTON_PRIOR()PRIOR_REC
0250 FUNCTION BUTTON_NEXT()NEXT_REC
0260 FUNCTION BUTTON_WRITE()WRITE_REC
0270 FUNCTION BUTTON_DEL()DELETE_REC
0280 FUNCTION BUTTON_CLEAR()CLEAR_REC
0290 FUNCTION BUTTON_CANCEL()CANCEL_BUTTON
0300 FUNCTION DEFAULTONFOCUS()ONFOCUSCHECK_CHANGES
0310 FUNCTION DEFAULTCHANGE()FIND_REC
*DEL  0320-0390
*SKIP 0390 IF FLDR=0
0320 FUNCTION DEFAULTFOLDERPRELOAD()PREDISPLAY_FOLDER
0330 FUNCTION DEFAULTFOLDERPOSTLOAD()POSTDISPLAY_FOLDER
0340 FUNCTION INITIALIZEFOLDER_TAB_1()INIT_FOLDER_TAB_1
0350 FUNCTION INITIALIZEFOLDER_TAB_2()INIT_FOLDER_TAB_2
0360 FUNCTION ONFOCUSFOLDER_TAB_1()ONFOCUS_FOLDER_TAB_1
0370 FUNCTION ONFOCUSFOLDER_TAB_2()ONFOCUS_FOLDER_TAB_2
0380 FUNCTION INITIALIZEFOLDER_TAB_2M()INIT_FOLDER_TAB_2M
0390 FUNCTION ONFOCUSFOLDER_TAB_2M()ONFOCUS_FOLDER_TAB_2M
0400 END DEF
0500 ! 500 - On create 
0510 ON_CREATE:
0520 ENTER PANEL_NM$,LIBRARY$,ERR=*NEXT
0530 RETURN
0600 ! 600 - Initialization
0610 INIT:
0620 LET _SV_XI=PRM('XI'),_SV_KR=PRM('KR'); SET_PARAM 'KR'=0 ! Ensure native handling of KEP()
0630 GOSUB SETUP_LIBRARY;IF %flmaint_msg$<>"" THEN MESSAGE_LIB %flmaint_msg$ 
0640 LET CHANGE_FLG=0,_ENABLE_FLG=0,_KCNT=1,_FIRST_KEY=0,_FIRST_FIELD=0
0650 GOSUB SETUP_KEYS
*FLNM 0660
*IF  LOCK_SEGMENT$="0"
T0670 LET _FIL_NO=HFN; OPEN (_FIL_NO,IOL=*,OPT=_FILE_OPTS$,ERR=OPEN_ERR)_FILE_NAME$
F0670 LET _FIL_NO=HFN; OPEN (_FIL_NO,IOL=*,OPT=_FILE_OPTS$,ERR=OPEN_ERR)_FILE_NAME$;READ (_FIL_NO,KEY=MIN_KEY$,DOM=*NEXT)
ENDIF
0680 STATIC IOL=IOL(_FIL_NO)
*DEL  0690-0690
*NUMF 0690
0700 GOSUB BUILD_ALT_IOLISTS;IF _OBJ_LOGIC1$<>"" AND TCB(32)>8 THEN _INTERFACE$=_OBJ_LOGIC1$;_IF$="INIT";GOSUB DO_INTERFACE;IF _IF_ERR$<>"" THEN CMD_STR$="END"
0710 RETURN 
0720 OPEN_ERR:MSGBOX _MSG_FILOPNERR1$+QUO+_FILE_NAME$+QUO+SEP+_MSG_DIRECTORY$+LWD+SEP+_MSG_PREFIX$+PFX,MSG(ERR),"!"
0730 LET CMD_STR$="END"
0740 RETURN 
0800 ! 800 - Set up the message library
0810 SETUP_LIBRARY:
0820 LET _SV_MSGLIB$=MSG(*)
*MLIB 0830
0860 SET_MSG: GOSUB SETUP_MESSAGES
0870 RETURN 
*DEL 0900-0990
0900 ! 900 - Set up key information
0910 SETUP_KEYS:
*NKEY 0920
0990 RETURN
1000 ! 1000 - Main panel post_display logic
1010 MAIN_POST_DISPLAY:
1020 MESSAGE_LIB _SV_MSGLIB$
1030 GOSUB CLEAR_REC; _IF$="POST_DISPLAY";GOSUB DO_INTERFACE
1040 IF ARG_1$="" THEN LET _ENABLE_FLG=_KEY1,isArg=0; GOSUB ENABLE_GROUPS; RETURN
1050 LET _KEY$=ARG_1$,isArg=1
*PKEY 1060
1070 _EOM$=$0D$,_KCNT=_NUMKEYS,_ENABLE_FLG=_NUMKEYS
1080 GOSUB FIND_REC
1090 RETURN 
*DEL  1200-1290
*SKIP 1240 IF FLDR=0
1200 ! 1200 - Set up tabbing between folders
1210 INIT_FOLDER:
1220 GOSUB ENABLE_GROUPS
1230 IF _ENABLE_FLG<>_KEY1 THEN IF TAB_FLG$="<" THEN NEXT_ID=_LAST_TAB ELSE NEXT_ID=_FIRST_TAB
1240 EXIT 
1400 ! 1400 - Wrapup
1410 WRAPUP:_IF$="WRAPUP"; GOSUB DO_INTERFACE
1420 LET ARG_1$=KEC(_FIL_NO,ERR=*NEXT)
1430 IF _FIL_NO<>0 THEN CLOSE (_FIL_NO); LET _FIL_NO=0
1450 MESSAGE_LIB _SV_MSGLIB$ 
1460 SET_PARAM 'KR'=_SV_KR
1470 RETURN 1
1500 ! 1500 - Start of maintenance only code - Find/Add/Delete/Clear record
1510 FIND_REC:
1520 IF isArg THEN GOTO FR1 ELSE LET _CONTROL_NAME$=_OBJ'GetVariable$(id),_KEYFIELD=0
1530 FOR I=1 TO _NUMKEYS
1540 IF STP(UCS(_CONTROL_NAME$),1,"$")=STP(UCS(_KEYS$[I]),1,"$") THEN LET _KEYFIELD=1;BREAK 
1550 NEXT
1560 IF NOT(_KEYFIELD) THEN RETURN
1570 FR1:CHANGE_FLG=0;IF POS(_EOM$=$000102090d$)=0 THEN RETURN ELSE GOSUB GET_CURKEY;IF _EOM$=$00$ THEN cv$=EVS(STP(_KEYS$[_CURKEY],1,"$")+"$");IF QRY_VAL$<>"" AND QRY_VAL$=CV$ THEN QRY_VAL$="" ELSE IF CV$=PRIOR_VAL$ THEN RETURN
1580 IF _ENABLE_FLG<0 THEN LET _KCNT=_KEY1,_ENABLE_FLG=_KEY1
1590 IF _ENABLE_FLG THEN IF _KCNT<_NUMKEYS THEN LET _KCNT=_CURKEY+1,_ENABLE_FLG=_KCNT; GOSUB ENABLE_GROUPS; RETURN ! If multiple key segments, enable the _KCNT segment
*KEYS 1600
1610 IF NUL(STP(_KEY$,1,$00$)) THEN NEXT_ID=_first_key;RETURN 
*IF  UPD_OPT$="2"
T1620 EXTRACT (_FIL_NO,KEY=_KEY$,DOM=NEW_RECORD,ERR=CHK_ERR_NXT)
F1620 READ (_FIL_NO,KEY=_KEY$,DOM=NEW_RECORD,ERR=CHK_ERR_NXT)
ENDIF
1630 _IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN READ DATA FROM "" TO IOL=IOL(_FIL_NO); NEXT_ID=_FIRST_KEY,CHANGE_FLG=0; EXIT ELSE GOSUB PROCESS_READ
1640 GOSUB NUM_TO_STR
1650 LET CHANGE_FLG=0,REFRESH_FLG=1,NEXT_ID=_first_field,isArg=0
1660 EXIT 
1700 ! 1700 - New RECORD check
1710 NEW_RECORD:
*IF  GEN_CNF_NEW$="1"
T1720
F1720 IF isArg THEN isArg=0 ELSE GOTO 1750
ENDIF
1730 LET _R_KEY$=_KEY$; TRANSLATE _R_KEY$," ",$00$
1740 MSGBOX _MSG_REC_MISS1$+_R_KEY$+_MSG_REC_MISS2$+SEP+_MSG_REC_CR_NEW$,_MSG_NOT_FOUND$,"?,YESNO",_YESNO$; IF _YESNO$="NO" THEN LET NEXT_ID=_first_key,CHANGE_FLG=0;EXIT 

*IF  CLEAR_OPT$="2" 
T1750 _CLR_FLG$="F";GOSUB CLEAR_FIELDS
F1750
ENDIF
1760 IF _ENABLE_FLG THEN LET _KCNT=0,_ENABLE_FLG=-1; GOSUB ENABLE_GROUPS
1770 LET CHANGE_FLG=0,REFRESH_FLG=1,NEXT_ID=_first_field
*IF  FIRST_FOLDER$<>""
T1780 NEXT_FOLDER=_first_folder
F1780
ENDIF
1790 RETURN 
1900 ! 1900 - Add RECORD
1910 WRITE_REC:
1920 GOSUB STR_TO_NUM
1930 GOSUB CHECK_REQD_FLDS; IF _W_FLG=0 THEN IGNORE_EXIT=1;EXIT END_IF;_IF$="PRE_WRITE"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN IGNORE_EXIT=1; EXIT
*IF  UPD_OPT$="1" 
T1940 GOSUB REVIEW_WRITE; IF _ABORT_WRITE THEN _ABORT_WRITE=0; RETURN
ENDIF
*IF  UPD_OPT$<>"1" AND _EXKEY=0
T1940 WRITE (_FIL_NO,ERR=WRITE_ERROR); _IF$="POST_WRITE"; GOSUB DO_INTERFACE
ENDIF
*IF  UPD_OPT$<>"1" AND _EXKEY<>0
T1940 WRITE (_FIL_NO,KEY=_KEY$,ERR=WRITE_ERROR); _IF$="POST_WRITE"; GOSUB DO_INTERFACE 
ENDIF
*IF  UPD_OPT$<>"1" AND GEN_ACK_WRT$="1"
T1950 LET _R_KEY$=KEC(_FIL_NO); TRANSLATE _R_KEY$," ",$00$; MSGBOX _MSG_REC_UPDADD$+_R_KEY$,_FYI$,"INFO"
ENDIF
1960 IF _ENABLE_FLG THEN LET _KCNT=_KEY1,_ENABLE_FLG=_KEY1; GOSUB ENABLE_GROUPS
1970 LET CHANGE_FLG=0
1980 NEXT_ID=_first_key
1990 EXIT 
2100 ! 2100 - Delete
2110 DELETE_REC:_IF$="PRE_REMOVE"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN EXIT
*KEYS 2120
*IF  GEN_CNF_DEL$="1"
T2130 LET _R_KEY$=_KEY$; TRANSLATE _R_KEY$," ",$00$
T2140 MSGBOX _MSG_REC_VFYDEL1$+_R_KEY$+_MSG_REC_VFYDEL2$,_MSG_JUST_CHECK$,"?,YESNO",_X$
T2150 IF _X$<>"YES" THEN RETURN
F2130
F2140
F2150
ENDIF
2160 REMOVE (_FIL_NO,KEY=_KEY$,ERR=REMOVE_ERR);_IF$="POST_REMOVE"; GOSUB DO_INTERFACE
*IF  GEN_ACK_DEL$="1"
T2170 LET _R_KEY$=_KEY$; TRANSLATE _R_KEY$," ",$00$; MSGBOX _MSG_REC_REMOVE$+_R_KEY$,_FYI$,"INFO"
F2170
ENDIF
2180 IF _ENABLE_FLG THEN LET _KCNT=_KEY1,_ENABLE_FLG=_KEY1; GOSUB ENABLE_GROUPS
2190 LET CHANGE_FLG=0
2200 NEXT_ID=_first_key
2210 EXIT
2220 REMOVE_ERR:
2230 IF ERR=0 MSGBOX _MSG_REC_LOCKED$,_FYI$,"!"; EXIT 
2230 IF ERR=11 MSGBOX _MSG_REC_NOTFND$,_FYI$,"!"; EXIT 
2240 MSGBOX MSG("ACC_DENIED"),_FYI$,"!"
2250 EXIT
2300 ! 2300 - Clear record
2310 CLEAR_REC:
2320 IF CHANGE_FLG<>0 THEN GOSUB CHECK_CHANGES
2330 _CLR_FLG$="R";GOSUB CLEAR_FIELDS
2340 IF _ENABLE_FLG THEN LET _KCNT=_KEY1,_ENABLE_FLG=_KEY1; GOSUB ENABLE_GROUPS
2350 LET CHANGE_FLG=0
2360 RETURN
2500 ! 2500 - Browsing mode
2510 ! - Next
2520 NEXT_REC:
2530 IF CHANGE_FLG<>0 THEN GOSUB CHECK_CHANGES
*IF  UPD_OPT$="2"
T2540 LET _KEY$=KEY(_FIL_NO,END=END_OF_FILE);IF _KEY$=_CUR_KEY$ THEN READ (_FIL_NO,KEY=_KEY$);GOTO *SAME ! Get past extracted record
F2540 LET _KEY$=KEY(_FIL_NO,END=END_OF_FILE)
ENDIF
*IF  LOCK_SEGMENT$="0"
T2550
F2550 IF _KEY$>MAX_KEY$+$FF$ THEN GOTO END_OF_FILE
ENDIF
*IF  UPD_OPT$="2"
T2560 EXTRACT (_FIL_NO,KEY=_KEY$,ERR=*NEXT);_IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN GOTO NEXT_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
F2560 READ (_FIL_NO,KEY=_KEY$,ERR=*NEXT);_IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN GOTO NEXT_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
ENDIF
2570 CHK_ERR_NXT: SET_PARAM 'XI'=_SV_XI;IF ERR<>0 THEN EXIT ERR
2580 LET isArg=0,_D$=_MSG_NEXT$; GOSUB BUSY_CHK
*IF  UPD_OPT$="2"
T2590 SET_PARAM 'XI'=1;LET _KEY$=KEY(_FIL_NO,END=END_OF_FILE);READ (_FIL_NO,KEY=_KEY$,ERR=CHK_ERR_NXT);LET _KEY$=KEY(_FIL_NO,END=END_OF_FILE);SET_PARAM 'XI'=_SV_XI; EXTRACT (_FIL_NO,KEY=_KEY$,ERR=CHK_ERR_NXT);_IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN GOTO NEXT_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
F2590 SET_PARAM 'XI'=1;LET _KEY$=KEY(_FIL_NO,END=END_OF_FILE);READ (_FIL_NO,KEY=_KEY$,ERR=CHK_ERR_NXT);LET _KEY$=KEY(_FIL_NO,END=END_OF_FILE);SET_PARAM 'XI'=_SV_XI; READ (_FIL_NO,KEY=_KEY$,ERR=CHK_ERR_NXT); _IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN GOTO NEXT_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
ENDIF
2600 END_OF_FILE: SET_PARAM 'XI'=_SV_XI;MSGBOX _MSG_END_OF_FIL$,_FYI$,"!"; EXIT 
2700 ! 2700 - Prior record
2710 PRIOR_REC:
2720 IF CHANGE_FLG<>0 THEN GOSUB CHECK_CHANGES
*IF  LOCK_SEGMENT$="0" AND UPD_OPT$<>"2"
T2730 LET _KEY$=KEP(_FIL_NO,END=START_OF_FILE); READ (_FIL_NO,KEY=_KEY$,ERR=*NEXT); _IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN GOTO PRIOR_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
ENDIF
*IF  LOCK_SEGMENT$="0" AND UPD_OPT$="2"
T2730 LET _KEY$=KEP(_FIL_NO,END=START_OF_FILE); EXTRACT (_FIL_NO,KEY=_KEY$,ERR=*NEXT); _IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN GOTO PRIOR_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
ENDIF
*IF  LOCK_SEGMENT$<>"0" AND UPD_OPT$<>"2"
T2730 LET _KEY$=KEP(_FIL_NO,END=START_OF_FILE); IF _KEY$<MIN_KEY$ THEN GOTO START_OF_FILE ELSE READ (_FIL_NO,KEY=_KEY$,ERR=*NEXT); _IF$="POST_READ"; GOSUB DO_INTERFACE; IF  _IF_ERR$<>"" THEN GOTO PRIOR_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
ENDIF
*IF  LOCK_SEGMENT$<>"0" AND UPD_OPT$="2"
T2730 LET _KEY$=KEP(_FIL_NO,END=START_OF_FILE); IF _KEY$<MIN_KEY$ THEN GOTO START_OF_FILE ELSE EXTRACT (_FIL_NO,KEY=_KEY$,ERR=*NEXT); _IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN GOTO PRIOR_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
ENDIF
2740 CHK_ERR_PRE: IF ERR<>0 THEN EXIT ERR
2750 LET _D$=_MSG_PRECEDING$; GOSUB BUSY_CHK
*IF  UPD_OPT$="2"
T2760 LET _KEY$=KEP(_FIL_NO,KEY=_KEY$,END=START_OF_FILE); EXTRACT (_FIL_NO,KEY=_KEY$,ERR=CHK_ERR_PRE); _IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN GOTO PRIOR_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
F2760 LET _KEY$=KEP(_FIL_NO,KEY=_KEY$,END=START_OF_FILE); READ (_FIL_NO,KEY=_KEY$,ERR=CHK_ERR_PRE); _IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN GOTO PRIOR_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
ENDIF
2770 START_OF_FILE: MSGBOX _MSG_START_FILE$,_FYI$,"!"; EXIT 
2900 ! 2900 - First record
2910 FIRST_REC:
2920 IF CHANGE_FLG<>0 THEN GOSUB CHECK_CHANGES
*IF  LOCK_SEGMENT$="0"
T2930 LET _KEY$=KEF(_FIL_NO,ERR=NO_FIRST)
T2940
F2930 LET _KEY$=MIN_KEY$;READ (_FIL_NO,KEY=_KEY$,DOM=*NEXT,ERR=CHK_ERR_NXT);GOTO 2950
F2940 LET _KEY$=KEY (_FIL_NO,ERR=NO_FIRST);IF _KEY$>MAX_KEY$+$FF$ THEN GOTO NO_FIRST
ENDIF
*IF  UPD_OPT$="2"
T2950 EXTRACT (_FIL_NO,KEY=_KEY$,ERR=NO_FIRST); _IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN GOTO NEXT_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
F2950 READ (_FIL_NO,KEY=_KEY$,ERR=NO_FIRST); _IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN GOTO NEXT_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
ENDIF
2960 NO_FIRST:IF ERR=0 THEN READ (_FIL_NO,KEY="",ERR=*PROCEED);DEF ERR=0;GOTO CHK_ERR_NXT ELSE MSGBOX _MSG_REC_NO_1ST$,_FYI$,"!"; EXIT 
3100 ! 3100 - Last record
3110 LAST_REC:
3120 IF CHANGE_FLG<>0 THEN GOSUB CHECK_CHANGES
*IF  LOCK_SEGMENT$="0"
T3130 LET _KEY$=KEL(_FIL_NO,ERR=NO_LAST)
T3140
F3130 LET _KEY$=MAX_KEY$+$FF$;READ (_FIL_NO,KEY=_KEY$,DOM=*NEXT,ERR=CHK_ERR_PRE);GOTO 3150
F3140 LET _KEY$=KEP (_FIL_NO,ERR=NO_LAST);IF _KEY$<MIN_KEY$ THEN GOTO NO_LAST
ENDIF
*IF  UPD_OPT$="2"
T3150 EXTRACT (_FIL_NO,KEY=_KEY$,ERR=CHK_ERR_PRE); _IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN GOTO PRIOR_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
F3150 READ (_FIL_NO,KEY=_KEY$,ERR=CHK_ERR_PRE); _IF$="POST_READ"; GOSUB DO_INTERFACE; IF _IF_ERR$<>"" THEN GOTO PRIOR_REC ELSE GOSUB PROCESS_READ; GOTO DISP_REC
ENDIF
3160 NO_LAST:MSGBOX _MSG_REC_NO_LST$,_FYI$,"!"; EXIT 
3500 ! 3500 - Subroutines
3510 ! Processing required by READ
3520 PROCESS_READ:
*IF  _EXKEY
T3530 READ DATA FROM _KEY$ TO IOL=IOL(_FIL_NO:KEY,ERR=*NEXT) ! load fields from external key
F3530
ENDIF
3540 IF _ENABLE_FLG THEN LET _KCNT=_KEY1-1,_ENABLE_FLG=-1; GOSUB ENABLE_GROUPS
3550 LET _CUR_KEY$=_KEY$,CHANGE_FLG=0
*IF  UPD_OPT$="1"
T3550 READ DATA FROM REC(IOL(_FIL_NO,ERR=*NEXT)) TO IOL=_ORIG_LIST$ ! Save record for review
ENDIF
3570 RETURN
*DEL  3700-3940
*SKIP 3870 IF UPD_OPT$<>"1"
3700 ! 3700 - Review record for changes before WRITE 
3710 REVIEW_WRITE:
3720 LET _CHG1$="",_CHG2$="",_ABORT_WRITE=0
3730 EXTRACT (_FIL_NO,KEY=KEC(_FIL_NO),DOM=WRT,ERR=REC_BUSY)IOL=_CUR_LIST$
3740 GOSUB DETERMINE_CHGS
3750 IF _CHG1$="" AND _CHG2$="" THEN GOTO WRT
3760 IF _CHG1$="" THEN GOTO CHK2
3770 MSGBOX _MSG_UPD_SAME$+SEP+_CHG1$+SEP+SEP+_MSG_OVRWRT_CHG$,_MSG_WARNING$,"Yesno,1,!",_YESNO$
3780 IF _YESNO$="NO" THEN GOTO *RETURN
3790 IF _CHG2$="" THEN GOTO WRT
3800 CHK2:IF _CHG2$<>"" THEN MSGBOX _MSG_UPD_OTHER1$+SEP+_CHG2$+SEP+SEP+_MSG_UPD_OTHER2$,_FYI$,"!"
3810 GOSUB INCORPORATE_CHGS
*IF  _EXKEY=0
T3820 WRT:WRITE (_FIL_NO,ERR=WRITE_ERROR);_IF$="POST_WRITE"; GOSUB DO_INTERFACE
F3820 WRT:WRITE (_FIL_NO,KEY=_KEY$,ERR=WRITE_ERROR);_IF$="POST_WRITE"; GOSUB DO_INTERFACE
ENDIF
*IF  GEN_ACK_WRT$="1"
T3830  LET _R_KEY$=KEC(_FIL_NO); TRANSLATE _R_KEY$," ",$00$; MSGBOX _MSG_REC_UPDADD$+_R_KEY$,_FYI$,"INFO"
F3830
ENDIF
3840 READ DATA FROM REC(IOL(_FIL_NO,ERR=*NEXT)) TO IOL=_ORIG_LIST$ ! Save record for review
3850 GOSUB NUM_TO_STR
3860 LET REFRESH_FLG=1
3870 RETURN 
3880 WRITE_ERROR:
3890 IF ERR=11 THEN MSGBOX _MSG_DUP_UNIQUE$,_MSG_CANNOT_WRITE$ ELSE MSGBOX MSG(ERR),_MSG_CANNOT_WRITE$
3900 RETURN
*IF  UPD_OPT$="1"
T3910 REC_BUSY:
T3920 IF ERR=0 THEN MSGBOX _MSG_REC_LOCKED$,_MSG_CANNOT_WRITE$ ELSE MSGBOX MSG_CANNOT_WRITE$+SEP+MSG(ERR),_ERROR$
T3930 _ABORT_WRITE=1
T3940 RETURN
F3910
F3920
F3930
F3940
ENDIF
4000 ! 4000 - Display a record
4010 DISP_REC:
4020 GOSUB NUM_TO_STR
4030 LET REFRESH_FLG=1
4040 RETURN 
4100 ! 4100 - Busy Record display
4110 BUSY_CHK:
4120 MSGBOX _MSG_REC_LOCKED$+SEP+SEP+_MSG_REC_VIEW1$+_D$+_MSG_REC_VIEW2$,_MSG_REC_ACCESS$,"YESNO,!",_D$
4130 IF _D$="NO" THEN EXIT 
4140 RETURN
4290 !4290 - See if changes are to be written
4300 ONFOCUSCHECK_CHANGES:
4320 LET _CONTROL_NAME$=_OBJ'GetVariable$(id),_KEYFIELD=0
4330 FOR I=1 TO _NUMKEYS
4340 IF UCS(_CONTROL_NAME$)=UCS(_KEYS$[I]) THEN LET _KEYFIELD=1;BREAK 
4350 NEXT
4360 IF NOT(_KEYFIELD) THEN RETURN
4370 IF _FIRST_KEY<>0 THEN IF ID<>_FIRST_KEY THEN RETURN 
4380 CHECK_CHANGES:
*INCT 4390
4400 IF CHANGE_FLG=0 THEN IF _ENABLE_FLG THEN GOTO CC ELSE GOTO *RETURN
4410 MSGBOX _MSG_REC_ALTERD$,_MSG_UPDATE$,"?,Yesno",_YESNO$
4420 IF _YESNO$="YES" THEN GOTO WRITE_REC
4430 LET CHANGE_FLG=0
4440 CC:LET _KCNT=_KEY1,_ENABLE_FLG=_KEY1; GOSUB ENABLE_GROUPS
4450 RETURN
4500 ! 4500 - Get the current key segment number
4510 GET_CURKEY:
4520 FOR _CURKEY=1 TO _NUMKEYS
4530 IF STP(_KEYS$[_CURKEY],1,"$")=UCS(STP(ID$,1,"$")) THEN BREAK
4540 NEXT _CURKEY
4550 RETURN
5000 ! 5000 - Logic for exit button
5010 CANCEL_BUTTON:
5020 GOSUB CHECK_CHANGES
5030 LET CMD_STR$="END"
5040 RETURN 
*DEL  5100-5830
*SKIP 5830 IF FLDR=0
5100 ! 5100 - Save NEXT_FOLDER information
5110 INIT_FOLDER_TAB_2M:
5120 LET _ONFOCUSFOLDER_TAB_2M$=_OBJ_EXTENSION$
5130 RETURN
5200 ! 5200 - Set NEXT_FOLDER variable
5210 ONFOCUS_FOLDER_TAB_2M:
5220 IF _ONFOCUSFOLDER_TAB_2M$>"" THEN EXECUTE _ONFOCUSFOLDER_TAB_2M$(2),ERR=*NEXT
5230 RETURN
5300 ! 5300 - Save NEXT_FOLDER information
5310 INIT_FOLDER_TAB_1:
5320 LET _ONFOCUSFOLDER_TAB_1$=_OBJ_EXTENSION$
5330 RETURN
5400 ! 5400 - Save NEXT_FOLDER information
5410 INIT_FOLDER_TAB_2:
5420 LET _ONFOCUSFOLDER_TAB_2$=_OBJ_EXTENSION$
5430 RETURN
5500 ! 5500 - Set NEXT_FOLDER variable
5510 ONFOCUS_FOLDER_TAB_1:
5520 IF _ONFOCUSFOLDER_TAB_1$>"" THEN EXECUTE _ONFOCUSFOLDER_TAB_1$(2),ERR=*NEXT
5530 RETURN
5600 ! 5600 - Set NEXT_FOLDER variable
5610 ONFOCUS_FOLDER_TAB_2:
5620 IF _ONFOCUSFOLDER_TAB_2$>"" THEN EXECUTE _ONFOCUSFOLDER_TAB_2$(2),ERR=*NEXT
5630 RETURN
5700 ! 5700 - Folder pre-display logic
5710 PREDISPLAY_FOLDER:
5720 LET _FOLDER_DISPLAY_LOGIC$=_OBJ_EXTENSION$
5730 RETURN 
5800 ! 5800 - Folder post-display logic 
5810 POSTDISPLAY_FOLDER:
5820 EXECUTE _FOLDER_DISPLAY_LOGIC$(2),ERR=*RETURN
5830 RETURN
6000 ! 6000 - Build alternate iolists
6010 BUILD_ALT_IOLISTS:
6020 LET _ORIG_LIST$="IOLIST ",_CUR_LIST$="IOLIST ",_XX$="",_STRVAR_LIST$="IOLIST "
6030 LET _IOLIST$=LST(IOL(_FIL_NO))+","; LET _IOLIST$=_IOLIST$(8); LET _P=POS(","=_IOLIST$,1,0); DIM _ORIGLIST$[1:_P]
6040 READ DATA FROM _IOLIST$,SEP="," TO _ORIGLIST${ALL}
6050 ! Check variables for "," - variables defined with one of the following format masks: Fixed, Padded, Substring, Last Substring 
6060 FOR _I=1 TO _P 
6070 LET _X$=_ORIGLIST$[_I],_N=0,_Q=0
6080 LET _Q=POS("]"=_X$); IF _Q>0 THEN LET _XX$+=_X$+$01$; CONTINUE
6090 LET _N=POS(":["=_X$); IF _N>0 THEN LET _XX$+=_X$+","
6100 IF _Q=0 AND _N=0 THEN LET _XX$+=_X$+$01$
6110 NEXT
6120 READ DATA FROM _XX$,SEP=$01$ TO _ORIGLIST${ALL};LET _P=POS($01$=_XX$,1,0)
6130 FOR _I=1 TO _P
6140 LET _ORIG_LIST$+="_ORIG."+_ORIGLIST$[_I]+","
6150 LET _CUR_LIST$+="_CUR."+_ORIGLIST$[_I]+","
6160 _VAR$=_ORIGLIST$[_I];IF POS(_VAR$+","=UCS(_NUMDEF$)) THEN IF _VAR$(LEN(_VAR$))<>"$" THEN LET _VAR$+="$"
6170 _STRVAR_LIST$+=_VAR$+","
6180 NEXT _I
6190 LET _ORIG_LIST$=CPL(STP(_ORIG_LIST$,1,",")),_CUR_LIST$=CPL(STP(_CUR_LIST$,1,",")),_STRVAR_LIST$=CPL(STP(_STRVAR_LIST$,1,","))
6200 STATIC IOL=_ORIG_LIST$
6210 STATIC IOL=_CUR_LIST$
6220 STATIC IOL=_STRVAR_LIST$
6230 RETURN
08000 ! 
08010 DO_INTERFACE:
08020 _IF_ERR$=""
08030 IF _INTERFACE$="" OR POS("<"+_IF$+">"=_IF_ABSENT$) THEN RETURN
08040 PERFORM _INTERFACE$+";FM_"+_IF$,ERR=BAD_INTERFACE
08050 GOTO CHK_INTERFACE
08060 !
08070 BAD_INTERFACE:
08080 IF ERR=55 THEN _IF_ABSENT$+="<"+_IF$+">"; RETURN
08090 _IF_ERR$=" "
08100 _IF_ERR$=MSG(ERR,ERR=*NEXT)
08110 !
08120 CHK_INTERFACE:
08130 IF NOT(NUL(_IF_ERR$)) THEN MSGBOX _IF_ERR$
08140 RETURN
08150!
09000 ! 9000 - Retrieve messages from the *msglib.xxx library
09010 SETUP_MESSAGES:
09020 LET _FYI$=MSG("FYI"),_ERROR$=MSG("ERROR")
09030 LET _MSG_DIRECTORY$=MSG("DIRECTORY")
09040 LET _MSG_END_OF_FIL$=MSG("END_OF_FIL")
09050 LET _MSG_FILOPNERR1$=MSG("FILOPNERR1")
09060 LET _MSG_JUST_CHECK$=MSG("JUST_CHECK")
09070 LET _MSG_MANDATORY$=MSG("MANDATORY")
09080 LET _MSG_NEXT$=MSG("NEXT")
09090 LET _MSG_NON_NUMER$=MSG("NON_NUMER")
09100 LET _MSG_NOT_FOUND$=MSG("NOT_FOUND")
09110 LET _MSG_OVRWRT_CHG$=MSG("OVRWRT_CHG")
09120 LET _MSG_PRECEDING$=MSG("PRECEDING")
09130 LET _MSG_PREFIX$=MSG("PREFIX")
09140 LET _MSG_REC_ACCESS$=MSG("REC_ACCESS")
09150 LET _MSG_REC_ALTERD$=MSG("REC_ALTERD")
09160 LET _MSG_REC_CR_NEW$=MSG("REC_CR_NEW")
09170 LET _MSG_REC_LOCKED$=MSG("REC_LOCKED")
09180 LET _MSG_X$=MSG("REC_MISS","^"),P=POS("^"=_MSG_X$),_MSG_REC_MISS1$=_MSG_X$(1,P-1),_MSG_REC_MISS2$=_MSG_X$(P+1)
09190 LET _MSG_REC_NOTFND$=MSG("REC_NOTFND")
09200 LET _MSG_REC_NO_1ST$=MSG("REC_NO_1ST")
09210 LET _MSG_REC_NO_LST$=MSG("REC_NO_LST")
09220 LET _MSG_REC_REMOVE$=MSG("REC_REMOVE")
09230 LET _MSG_REC_UPDADD$=MSG("REC_UPDADD")
09240 LET _MSG_X$=MSG("REC_VFYDEL","^"),P=POS("^"=_MSG_X$),_MSG_REC_VFYDEL1$=_MSG_X$(1,P-1),_MSG_REC_VFYDEL2$=_MSG_X$(P+1)
09250 LET _MSG_X$=MSG("REC_VIEW","^"),P=POS("^"=_MSG_X$),_MSG_REC_VIEW1$=_MSG_X$(1,P-1),_MSG_REC_VIEW2$=_MSG_X$(P+1)
09260 LET _MSG_REQ_FIELDS$=MSG("REQ_FIELDS")
09270 LET _MSG_START_FILE$=MSG("START_FILE")
09280 LET _MSG_UPDATE$=MSG("UPDATE")
09290 LET _MSG_UPD_OTHER1$=MSG("UPD_OTHER1")
09300 LET _MSG_UPD_OTHER2$=MSG("UPD_OTHER2")
09310 LET _MSG_UPD_SAME$=MSG("UPD_SAME")
09320 LET _MSG_WARNING$=MSG("WARNING")
09330 LET _MSG_CANNOT_WRITE$=MSG("CANT_WRITE")
09340 LET _MSG_DUP_UNIQUE$=MSG("DUP_UNIQUE")
09350 RETURN
10000 ! 10000 - Convert numeric values to string
10010 NUM_TO_STR:
*DEL  10020-10990
*CVTN 10020
10999 RETURN
11000 ! 11000 - Convert numeric strings to number
11010 STR_TO_NUM:
*DEL  11020-11960
*CVTS 11020
11970 RETURN
11980 NON_NUMERIC:MSGBOX _MSG_NON_NUMER$+_X$,_ERROR$,"!"
11990 LET NEXT_ID=_X
11999 EXIT
12000 ! 12000 - Check if the required fields have data
12010 CHECK_REQD_FLDS:
*IF  RCNT>0
T12020 LET _W_FLG=1,_REQ_LST$="",_REQ_CTL=0,_nf=0
F12020 LET _W_FLG=1
ENDIF
*REQD 12030
*IF  RCNT>0
T12990 IF _REQ_LST$<>"" THEN LET _W_FLG=0; MSGBOX _MSG_REQ_FIELDS$+SEP+_REQ_LST$,_MSG_MANDATORY$;NEXT_ID=_REQ_CTL;IF _NF>0 THEN NEXT_FOLDER=_NF,NEXT_ID$=_NI$
F12990
ENDIF
12999 RETURN 
13000 ! 13000 - Clear the record fields
13010 CLEAR_FIELDS:
*DEL  13020-13970
*CLR  13020
13980 GOSUB NUM_TO_STR
13990 LET REFRESH_FLG=1
13999 RETURN 
14000 ! 14000 - Enable/Disable groups - _ENABLE_FLG: 0=don't!, >1=corresponding key segment on, others off, -1=buttons and non-key fields on
14010 ENABLE_GROUPS:
14020 IF _ENABLE_FLG=0 THEN GOTO *RETURN
*DEL  14030-14960
*ENAB 14030
14970 IF _ENABLE_FLG>0 THEN CALL "*wingrp;Disable",FIELDS.GRP$; CALL "*wingrp;Disable",BUTTONS.GRP$
14980 IF _ENABLE_FLG<0 THEN CALL "*wingrp;Enable",FIELDS.GRP$; CALL "*wingrp;Enable",BUTTONS.GRP$
14990 RETURN 
*DEL  15000-16990
*SKIP 16990 IF UPD_OPT$<>"1"
15000 ! 15000 - Determine the changes that have been made before writing
15010 DETERMINE_CHGS:
*DCHG 15020
15990 RETURN
16000 ! 16000 - Incorporate changes made by another user into the record
16010 INCORPORATE_CHGS:
*ICHG 16020
16990 RETURN

